﻿Option Explicit On

Imports OfekInventory.Microsoft.Office.Interop.Excel

Module MODexport

    Private _
        oConn As ADODB.Connection, _
        oRS As ADODB.Recordset, _
        fso As Scripting.FileSystemObject, _
        oTextFile As Scripting.TextStream

    Dim _
        sTableToExport As String, _
        sFieldsToExport As String, _
        sExportPath As String

    Dim i As Long

    ' Export to Excel by creating a new workbook and worksheets, then show the Application to the user and save it --------------------------

    Public Function exportToExcel(ByVal sTableToExport As String, ByVal sFieldsToExport As String, ByVal sExportPath As String) As Boolean

        '        On Error Resume Next

        '        Dim _
        '            oExcel As Excel.Application, _
        '            oWorkbook As Excel.Workbook, _
        '            oWorkSheet As Excel.WorkSheet

        '        Dim _
        '            iTotalWorkSheets As Integer, _
        '            iWorkSheetsToAdd As Integer

        '        DLGExport.Cursor = Cursors.WaitCursor
        '        FRMmain.Cursor = Cursors.WaitCursor
        '        DLGExport.CMDExport.Enabled = False

        '        If Not openRecordset(sTableToExport, sFieldsToExport) Then

        '            Exit Function

        '        End If

        '        DLGExport.ProgressBar.Visible = True
        '        DLGExport.ProgressBar.Value = 33

        '        ' Create a new Excel object ---------------------------------------------------------------------------------------------

        '        oExcel = New Excel.Application

        '        Throw New NotImplementedException("Make this operation occur on a seperate thread")

        '        If Err.Number <> 0 Then

        '            logMessage( _
        '                1, _
        '                "MODexport", _
        '                "Could not create new Excel application", _
        '                , _
        '                Err.Number, _
        '                Err.Description)

        '            MsgBox( _
        '                "Could not export" & vbCrLf & _
        '                "Reason : Could not create new Excel application")

        '            GoTo exitSub

        '        Else

        '            logMessage( _
        '                5, _
        '                "MODexport", _
        '                "Created Excel application object")

        '        End If

        '        oWorkbook = oExcel.Workbooks.Add

        '        DoEvents()

        '        If Err.Number <> 0 Then

        '            logMessage( _
        '                1, _
        '                "MODexport", _
        '                "Could not add workbook", _
        '                , _
        '                Err.Number, _
        '                Err.Description)

        '            MsgBox( _
        '                "Could not export" & vbCrLf & _
        '                "Reason : Could not add workbook")

        '            GoTo exitSub

        '        Else

        '            logMessage( _
        '                4, _
        '                "MODexport", _
        '                "Added workbook to Excel file")

        '        End If

        '        iTotalWorkSheets = Int(oRS.RecordCount / 65000) + 1

        '        On Error Resume Next

        '        If oWorkbook.Worksheets.Count < iTotalWorkSheets Then

        '            iWorkSheetsToAdd = iTotalWorkSheets - oWorkbook.Worksheets.Count

        '            oWorkbook.Worksheets.Add, , iWorkSheetsToAdd

        '            DoEvents()

        '            If Err.Number <> 0 Then

        '                logMessage( _
        '                    1, _
        '                    "MODexport", _
        '                    "Could not add worksheet", _
        '                    , _
        '                    Err.Number, _
        '                    Err.Description)

        '                MsgBox( _
        '                    "Could not export" & vbCrLf & _
        '                    "Reason : Could not add worksheet")

        '                GoTo exitSub

        '            Else

        '                logMessage( _
        '                    4, _
        '                    "MODexport", _
        '                    "Added worksheet to Excel file", _
        '                    "Worksheets added = " & iWorkSheetsToAdd)

        '            End If

        '        End If

        '        For i = 1 To iTotalWorkSheets


        '            Dim j As Integer

        '            DLGExport.ProgressBar.Value = i / iTotalWorkSheets * 100

        '            oWorkSheet = oWorkbook.Worksheets(i)

        '            For j = 1 To oRS.Fields.Count

        '                oWorkSheet.Cells(1, j).Value = oRS.Fields(j - 1).Name

        '                DoEvents()

        '            Next

        '            DoEvents()

        '            oWorkSheet.Cells(2, 1).CopyFromRecordset(oRS, 65000)

        '            DoEvents()

        '            If Err.Number <> 0 Then

        '                logMessage( _
        '                    1, _
        '                    "MODexport", _
        '                    "Could not copy from recordset", _
        '                    , _
        '                    Err.Number, _
        '                    Err.Description)

        '                MsgBox( _
        '                    "Could not export" & vbCrLf & _
        '                    "Reason : Could not copy from recordset")

        '                GoTo exitSub

        '            Else

        '                logMessage( _
        '                    4, _
        '                    "MODexport", _
        '                    "Copied records from recordset to Excel")

        '            End If

        '            oWorkSheet.Name = sTableToExport & "_" & i

        '        Next

        '        ' Make Excel visible -------------------------------------------------------------------------------------------------------------------

        '        'oExcel.Visible = True
        '        'oExcel.UserControl = True

        '        ' Save the Workbook -------------------------------------------------------------------------------------------------------------

        '        On Error Resume Next

        '        DoEvents()

        '        oWorkbook.SaveAs(sExportPath)

        '        DoEvents()

        '        If Err.Number <> 0 Then

        '            logMessage( _
        '                1, _
        '                "MODexport", _
        '                "Could not save Excel file", _
        '                "Path = " & sExportPath, _
        '                Err.Number, _
        '                Err.Description)

        '            MsgBox("Could not save Excel file")

        '            GoTo exitSub

        '        Else

        '            logMessage( _
        '                3, _
        '                "MODexport", _
        '                "Saved Excel file", _
        '                "Path = " & sExportPath)

        '        End If

        '        exportToExcel = True

        '        MsgBox("Finished exporting")

        'exitSub:

        '        DLGExport.MousePointer = vbArrow
        '        FRMmain.MousePointer = vbArrow

        '        oRS.Close()
        '        oConn.Close()

        '        oRS = Nothing
        '        oConn = Nothing

        '        oExcel.Quit()

        '        oExcel = Nothing
        '        oWorkbook = Nothing
        '        oWorkSheet = Nothing
        Throw New NotImplementedException
    End Function

    ' Export records to a text file -----------------------------------------------------------------------------------------------------

    Public Function exportToText(ByVal sTableToExport As String, ByVal sFieldsToExport As String, ByVal sExportPath As String)

        '        On Error Resume Next

        '        Dim _
        '            sLine As String, _
        '            sFieldValue As String

        '        Dim lTotalRecords As Long

        '        Dim oField As Field

        '        DLGExport.ProgressBar.Visible = True
        '        DLGExport.CMDExport.Enabled = False
        '        DLGExport.CMDcancel.Enabled = False
        '        FRMmain.MousePointer = vbHourglass
        '        DLGExport.MousePointer = vbHourglass

        '        If Not openRecordset(sTableToExport, sFieldsToExport) Then

        '            GoTo exitFunction

        '        End If

        '        On Error Resume Next

        '        fso = New Scripting.FileSystemObject

        '        If Err.Number <> 0 Then

        '            logMessage( _
        '                1, _
        '                "MODexport", _
        '                "Could not create FileSystem object for exporting to text file", _
        '                , _
        '                Err.Number, _
        '                Err.Description)

        '            GoTo exitFunction

        '        Else

        '            logMessage( _
        '                5, _
        '                "MODexport", _
        '                "Created FileSystem object for exporting to text file")

        '        End If


        '        If fso.FileExists(sExportPath) Then

        '            If MsgBox( _
        '                "A file with the name """ & sExportPath & """ already exists" & _
        '                vbCrLf & _
        '                "Would you like to replace it ?", vbOKCancel) <> 1 Then

        '                GoTo exitFunction

        '            End If

        '        End If

        '        oTextFile = fso.CreateTextFile(sExportPath, True)

        '        If Err.Number <> 0 Then

        '            logMessage( _
        '                1, _
        '                "MODexport", _
        '                "Could not create text file object for exporting to text file", _
        '                , _
        '                Err.Number, _
        '                Err.Description)

        '            fso = Nothing

        '            GoTo exitFunction

        '        Else

        '            logMessage( _
        '                5, _
        '                "MODexport", _
        '                "Created text file for exporting to text file")

        '        End If

        '        For Each oField In oRS.Fields

        '            sLine = sLine & oField.Name & vbTab

        '        Next

        '        oTextFile.WriteLine(sLine)

        '        sLine = ""

        '        i = 0

        '        lTotalRecords = oRS.RecordCount

        '        ' Loop through records and write to file ----------------------------------------------------------------------------------------

        '        Do Until oRS.EOF

        '            sLine = ""

        '            For Each oField In oRS.Fields

        '                sFieldValue = oField.Value

        '                ' replace commas, because they are used to seperate the fields ------------------------------------------------------------

        '                If sFieldValue <> "" Then

        '                    sFieldValue = Replace(sFieldValue, ",", "", 1, , vbTextCompare)

        '                End If

        '                sLine = sLine & sFieldValue & ","

        '            Next

        '            ' remove the last comma ----------------------------------------------------------------------------------------------------

        '            sLine = Utils.Left(sLine, Len(sLine) - 1)

        '            On Error Resume Next

        '            oTextFile.WriteLine(sLine)

        '            If Err.Number <> 0 Then

        '                logMessage( _
        '                    2, _
        '                    "MODexport", _
        '                    "Could not write line to text file", _
        '                    "Line = " & sLine, _
        '                    Err.Number, _
        '                    Err.Description)

        '                Err.Clear()

        '            End If

        '            DoEvents()

        '            i = i + 1

        '            DLGExport.ProgressBar.Value = i / lTotalRecords * 100

        '            oRS.MoveNext()

        '        Loop

        '        oTextFile.Close()

        '        oTextFile = Nothing
        '        fso = Nothing

        '        MsgBox("Finished exporting")

        '        Unload(DLGExport)

        'exitFunction:

        '        DLGExport.CMDExport.Enabled = True
        '        DLGExport.CMDcancel.Enabled = True
        '        FRMmain.MousePointer = vbArrow
        '        DLGExport.MousePointer = vbArrow
        Throw New NotImplementedException
    End Function

    ' Create a connectioon and open a recordet --------------------------------------------------------------------------------------

    Private Function openRecordset(ByVal sTableToExport As String, ByVal sFieldsToExport As String) As Boolean

        'On Error Resume Next

        'Dim sRSOpen As String

        'oConn = New ADODB.Connection

        'If Err.Number <> 0 Then

        '    logMessage( _
        '        1, _
        '        "MODexport", _
        '        "Could not create ADODB connection object", _
        '        , _
        '        Err.Number, _
        '        Err.Description)

        '    MsgBox( _
        '        "Could not export" & vbCrLf & _
        '        "Reason : Could not create connection to database")

        '    Exit Function

        'Else

        '    logMessage( _
        '        5, _
        '        "MODexport", _
        '        "Created new ADODB connection object")

        'End If

        'oRS = New ADODB.Recordset

        'If Err.Number <> 0 Then

        '    logMessage( _
        '        1, _
        '        "MODexport", _
        '        "Could not create ADODB recordset object", _
        '        , _
        '        Err.Number, _
        '        Err.Description)

        '    MsgBox( _
        '        "Could not export" & vbCrLf & _
        '        "Reason : Could not create connection to database recordset")

        '    Exit Function

        'Else

        '    logMessage( _
        '        5, _
        '        "MODexport", _
        '        "Created ADODB recordset object")

        'End If

        'Dim sConnection As String

        'sConnection = FRMmain.Adodc1.ConnectionString

        'oConn.Open(sConnection)

        'If Err.Number <> 0 Then

        '    logMessage( _
        '        1, _
        '        "MODexport", _
        '        "Could not open ADODB connection", _
        '        "Connection string = " & sConnection, _
        '        Err.Number, _
        '        Err.Description)

        '    MsgBox( _
        '        "Could not export" & vbCrLf & _
        '        "Reason : Could not open connection to database")

        '    Exit Function

        'Else

        '    logMessage( _
        '        4, _
        '        "MODexport", _
        '        "Opened ADODB connection", _
        '        "Connection string = " & sConnection)

        'End If

        'sRSOpen = "SELECT " & sFieldsToExport & " FROM " & sTableToExport & " ORDER BY [uniqueID]"

        'On Error Resume Next

        'oRS.Open(sRSOpen, oConn, 1, 3)

        'If Err.Number <> 0 Then

        '    logMessage( _
        '        1, _
        '        "MODexport", _
        '        "Could not open ADODB recordset", _
        '        "Recordset open string = " & sRSOpen, _
        '        Err.Number, _
        '        Err.Description)

        '    MsgBox( _
        '        "Could not export" & vbCrLf & _
        '        "Reason : Could not open recordset")

        '    Exit Function

        'Else

        '    logMessage( _
        '        4, _
        '        "MODexport", _
        '        "Opened ADODB recordset", _
        '        "Recordset open string = " & sRSOpen)

        'End If

        'openRecordset = True
        Throw New NotImplementedException
    End Function


    'Public Function export(tableToExport As String, strFieldsToExport As String, strExportAs As String, strExportMethod As String)
    '
    '    On Error Resume Next
    '
    '    FRMmain.MousePointer = 11
    '    DLGexport.MousePointer = 11
    '
    '    Dim conn As ADODB.Connection
    '    Dim r As ADODB.Recordset
    '    Dim openStr As String
    '    Dim strConn As String
    '
    '    Set conn = New ADODB.Connection
    '    Set r = New ADODB.Recordset
    '    Set fso = New Scripting.FileSystemObject
    '
    '    strConn = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & theFileName
    '    conn.Open strConn
    '
    '    openStr = "SELECT " & strFieldsToExport & " FROM " & tableToExport
    '    r.Open openStr, conn, 1, 3
    '
    '    Dim longFileRow As Long
    '    Dim intFileNumber As Integer
    '    Dim intNumberOfFiles As Integer
    '    Dim longNumberOfRecords As Long
    '    Dim strHeader As String
    '    Dim strLine As String
    '    intFileNumber = 1
    '    longNumberOfRecords = r.RecordCount
    '    intNumberOfFiles = Int(r.RecordCount / 65000) + 1
    '
    '    If strExportMethod = "excel" Then
    ''-------------------------------------------------------------------'
    ''   Export to Excel                                                 '
    ''-------------------------------------------------------------------'
    '        For i = 1 To intNumberOfFiles
    '            strExportAs = Replace(strExportAs, ".xls", "", , , vbTextCompare)
    '            Set excelFile = fso.CreateTextFile(Application.ExecutablePath & "/" & strExportAs & intFileNumber & ".xls", True, True)
    '            header = ""
    '            For Each fld In r.Fields
    '                header = header & fld.Name & Chr(9)
    '            Next
    '            excelFile.WriteLine header
    '            Do While longFileRow < 65001 And Not r.EOF
    '                strLine = ""
    '                For Each fld In r.Fields
    '                    strLine = strLine & fld.Value & Chr(9)
    '                Next
    '                excelFile.WriteLine strLine
    '                longFileRow = longFileRow + 1
    '                r.MoveNext
    '            Loop
    '            longFileRow = 0
    '            excelFile.Close
    '            Set excelFile = Nothing
    '            intFileNumber = intFileNumber + 1
    '        Next
    '    Else
    ''-------------------------------------------------------------------'
    ''   Export to Text File                                             '
    ''-------------------------------------------------------------------'
    '        intNumberOfFiles = 1
    '        Dim textFile As Object
    '        Set textFile = fso.CreateTextFile(Application.ExecutablePath & "/" & strExportAs, True, True)
    '        Dim line As String
    '        For Each fld In r.Fields
    '            header = header & fld.Name & Chr(9)
    '        Next
    '            textFile.WriteLine header
    '        Do Until r.EOF
    '            line = ""
    '            For Each fld In r.Fields
    '                Dim fieldVal
    '                If fld.Value <> "" And InStr(fld.Value, ",") <> 0 Then
    '                    fieldVal = Replace(fld.Value, ",", "", , , vbTextCompare)
    '                Else
    '                    fieldVal = fld.Value
    '                End If
    '                line = line & fieldVal & ","
    '            Next
    '            textFile.WriteLine line
    '            r.MoveNext
    '        Loop
    '        textFile.Close
    '        Set textFile = Nothing
    '        Set fso = Nothing
    '    End If
    'doStop:
    '    r.Close
    '    conn.Close
    '
    '    Set r = Nothing
    '    Set conn = Nothing
    '
    '    Set fs = Nothing
    '    Set excelFile = Nothing
    '    FRMmain.MousePointer = 0
    '    DLGexport.MousePointer = 0
    '    MsgBox "Finished Exporting " & intNumberOfFiles & " Files"
    'End Function
End Module
